Reprezentarea datelor sub forma de retea e o abordare diferita fata de modul clasic de reprezentare, cel tabelar. Acest format poate evidentia noi caracteristici ale datelor si imbunatesteste vizualizarea acestora intr-un mod semnificativ. Pentru a realiza o analiza originala, setul de date folosit reprezinta structura unei retele de trafic cu tigari de contrabanda din Romania, datele fiind extrase dintr-un dosar penal. Astfel, utilizand metode de graph mining vom realiza o analiza asupra structurii retelei, dar si asupra rolurilor individuale ale membrilor.
Datele au fost modelate folosind un obiect de tip reţea din librăria statnet. Legăturile dintre noduri au fost introduse folosind o lista de muchii, iar nodurile au următoarele atribute : nume, nume abreviat si rol.
netmat <- rbind(c(1,2),
c(1,3),
c(2,3),
c(1,4),
c(5,6),
c(7,8),
c(5,7),
c(5,8),
c(5,9),
c(6,7),
c(6,8),
c(6,9),
c(5,10),
c(6,10),
c(11,12),
c(11,13),
c(13,14),
c(14,19),
c(13,19),
c(14,1),
c(19,15),
c(19,16),
c(19,17),
c(19,18),
c(12,15),
c(12,16),
c(12,17),
c(12,18),
c(20,8),
c(20,9),
c(21,8),
c(21,9),
c(3,8),
c(3,9),
c(1,8),
c(1,9))
net <- network(netmat, matrix.type="edgelist")Pentru a ne asigura ca graful este unul ne-orientat, simetrizam matricea de adiacenta asociata primului obiect, si generam un nou obiect, pentru a lucra cu un graf ne-orientat. Acest lucru se datoreaza faptului ca relatiile sociale in cadrul acestei retele nu pot fi uni-directionale.
netmatsym <- symmetrize(as.sociomatrix(net), rule ="weak")
netsym <- network(netmatsym, matrix.type="adjacency")
network.vertex.names(netsym) <- c("B***cu L***na",
"B***cu An***us",
"B**scu C***nel",
"B**hiu G***ge",
"M**tu M**na",
"Ma**u I***he",
"T**a F**p",
"T**a G***ghe",
"S**m An**la",
"G**ca G****ghe",
"C**u I**n",
"M***u L**do",
"D**a D**a",
"D**a C**l",
"N**cu P**u",
"N**se T**er",
"S***an C***tin",
"O***u A**ei",
"D**a I***l",
"P**ci V***e",
"D***mir R**a")
set.vertex.attribute(netsym, "role", c("C",
"C",
"C",
"CR",
"C",
"C",
"CT",
"CT",
"CT",
"C",
"C",
"A",
"A",
"C",
"C",
"C",
"C",
"C",
"CT",
"D",
"D"))
# C : Comerciant, CR : Cartita, CT: contrabandist, A: aducator clienti, D: depozitare
set.vertex.attribute(netsym, "abrev_name", c("BL",
"BA",
"BC",
"BG",
"MM",
"MI",
"TF",
"TG",
"SA",
"GG",
"CI",
"ML",
"DD",
"DC",
"NP",
"NT",
"SC",
"OA",
"DI",
"PV",
"DR"))Extragerea atributelor retelei in variabile separate, pentru a fi folosite ulterior in operatiile de plotare.
netsym %v% "alldeg" <- degree(netsym)
namelab <- get.vertex.attribute(netsym, "vertex.names")
rolelab <- get.vertex.attribute(netsym, "role")
abrevnamelab <-get.vertex.attribute(netsym, "abrev_name")
my_pal <- brewer.pal(5,"Dark2")
rolecat <- as.factor(get.vertex.attribute(netsym,"role"))Un prim plot al retelei pentru a vizualiza structura acesteia, si impartirea membrilor pe roluri.
plot(netsym,
main = "Infractional network",
usearrows=FALSE,
mode="fruchtermanreingold",
vertex.col = my_pal[rolecat],
label=rolelab,
displaylabels=T,
vertex.cex = 1.5)O prima analiza asupra retelei este realizarea rezumatului in 5 puncte. Functiile prezente in libraria statnet faciliteaza realizarea acesteia. Analizand aceste valori, putem avea o prima impresie despre structura retelei si despre modul de organizarea a acesteia. O descriere sumara a celor cinci valori poate fi urmatoarea:
## Network attributes:
## vertices = 21
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges = 72
## missing edges = 0
## non-missing edges = 72
## density = 0.1714286
##
## Vertex attributes:
##
## abrev_name:
## character valued attribute
## attribute summary:
## the 10 most common values are:
## BA BC BG BL CI DC DD DI DR GG
## 1 1 1 1 1 1 1 1 1 1
##
## alldeg:
## numeric valued attribute
## attribute summary:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000 4.000 6.000 6.857 10.000 14.000
##
## role:
## character valued attribute
## attribute summary:
## A C CR CT D
## 2 12 1 4 2
## vertex.names:
## character valued attribute
## 21 valid vertex names
##
## No edge attributes
## [1] 21
## [1] 0.1714286
## [1] 1
## [1] 7
## [1] 0.25
Folosind atributele definite în momentul creării, putem filtra reţeua astfel încat putem evidenţia importanţa unui anume rol. Spre exemplu, dacă am păstra în reţea doar Comercianţii, putem observa că aceştia sunt în mare partea izolaţi, distrugând aspectul de reţea compactă. Acest lucru evidenţiază rolul contrabandiştilor în reţea, aceştia asigurând practic conexitatea reţelei.
print("Filtering networks")
print(get.vertex.attribute(netsym, "role"))
comercianti <- get.inducedSubgraph(netsym, which (netsym %v% "role"=="C"))
gplot(comercianti,displaylabels=TRUE, main="Comercianti")delete.vertices(comercianti, isolates(comercianti))
gplot(comercianti, displaylabels = TRUE, main="Grupuri de comercianti")Exista mai multe moduri de a vizualiza o retea, fiecare din aceste noduri prezentand o perspectiva diferita asupra datelor. Modul de vizualizare ales este important pentru a transmite cat mai multe informatii despre retea in mod vizual.
gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
vertex.cex=1.5,mode='circle',main="circle")gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
vertex.cex=1.5,mode='eigen',main="eigen")gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
vertex.cex=1.5,mode='random',main="random")gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
vertex.cex=1.5,mode='spring',main="spring")gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
vertex.cex=1.5,mode='fruchtermanreingold',main='fruchtermanreingold')gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
vertex.cex=1.5,mode='kamadakawai',
main='kamadakawai')Pot fi modificate mai multe aspecte vizuale ale retelei, atat legate de noduri cat si legate de muchii, pentru a prezenta mai bine informatiile in mod vizual.
library(network)
library(intergraph)
library(igraph)
library(networkD3)
plot(netsym,vertex.cex=0.5,main="Too small nodes")sidenum <- 3:7
rolecat <- as.factor(get.vertex.attribute(asIgraph(netsym),"role"))
plot(netsym,usearrows=FALSE,vertex.cex=4, main="Different node type",
displaylabels=F,vertex.sides=sidenum[rolecat])n_edge <- network.edgecount(netsym)
linecol_pal <- c("blue","red","green")
edge_cat <- sample(1:3,n_edge,replace=T)
plot(netsym,vertex.cex=1.5,vertex.col="grey25", main="Edge coloring example",
edge.col=linecol_pal[edge_cat],edge.lwd=2)n_edge <- network.edgecount(netsym)
edge_cat <- sample(1:3,n_edge,replace=T)
line_pal <- c(2,3,4)
gplot(netsym,vertex.cex=0.8,gmode="graph", main="Different edge type",
vertex.col="gray50",edge.lwd=1.5,
edge.lty=line_pal[edge_cat])my_pal <- brewer.pal(5,"Dark2")
rolecat <- as.factor(get.vertex.attribute(asIgraph(netsym),"role"))
plot(netsym,
main = "Infractional network",
usearrows=FALSE,
mode="fruchtermanreingold",
vertex.col = my_pal[rolecat],
label=abrevnamelab,
displaylabels=T,
vertex.cex = 1.5)
legend("bottomleft",legend=c("Aducator clienti","Comerciant","Cartita","Contrabandist","Depozitare"),
col=my_pal,pch=19,pt.cex=1.5,bty="n",
title="Criminal Role")Exista si moduri mai avansate de a prezenta vizual o retea, folosind biblioteci care pot genera retele mai interactive.
Heatmap este o reprezentare speciala a unei retele prin care ne este mai usor sa observam interactiunile intre diverse noduri ale retelei si cat de mult interactioneaza fiecare nod cu celelalte. # Capitolul 7: Importanta actantilor Un rol cheie pentru o buna intelegere a structurii unei retele este analiza nodurilor si descoperirea celor mai importante si celor critice. Analize similare se pot realiza si pentru relatiile dintre noduri.
Putem spune ca un nod este un actor proeminent intr-o retea daca prezenta lui are un impact special asupra retelei. Urmeaza sa vedem cateva astfel de exemple.
Vom incepe analiza cu determinarea nodurilor centrale dintr-o retea. Cele mai folosite masuri pentru aceasta sunt urmatoarele:
Mai jos, sunt expuse metodele pentru calculul centralitatii folosind aceste masuratori.
Cu exceptia acestora, exista si alte masuri ale centralitatii, insa rezultatele multora dintre acestea sunt corelate cu cele ale metodele prezentate anterior. Acest fapt este evidentiat si in calculele prezentate in continuare si poate fi explicat prin faptul ca aceste masuratori pornesc de la metodele de baza si aduc imbunatatiri.
# Computing the level of correlation between multiple centrality measures
df.prom <- data.frame(
deg = degree(netsym),
cls = closeness(netsym),
btw = betweenness(netsym),
evc = evcent(netsym),
inf = infocent(netsym),
flb = flowbet(netsym)
)
cor(df.prom)## deg cls btw evc inf flb
## deg 1.0000000 0.6013689 0.5917256 0.6360877 0.7918289 0.5708101
## cls 0.6013689 1.0000000 0.8545112 0.4791390 0.8593100 0.8230555
## btw 0.5917256 0.8545112 1.0000000 0.2297788 0.7352932 0.9357088
## evc 0.6360877 0.4791390 0.2297788 1.0000000 0.7469055 0.3381616
## inf 0.7918289 0.8593100 0.7352932 0.7469055 1.0000000 0.7994418
## flb 0.5708101 0.8230555 0.9357088 0.3381616 0.7994418 1.0000000
Pentru a putea determina daca un nod este central sau nu, se pot folosi rezultatele mai multor masuratori. In acest caz, concluzia ca un nod este central este data doar daca toate (sau majoritatea) metodelor ofera acest rezultat. Prin aceasta metoda, se obtine o mai buna acuratete in determinarea nodurilor centrale. Mai jos se poate observa o analiza pe setul de date a centralitatii pentru fiecare nod si fiecare masuratoarea prezentata.
# Tabular visualization for multiple centrality measures
# Defining a data frame in which is computed the centrality for all nodes using multiple methods
df.prom2 <- data.frame(
name = network.vertex.names(netsym),
degree = degree(netsym, gmode="graph"),
closeness = closeness(netsym, gmode="graph"),
betweenness = betweenness(netsym, gmode="graph"))
df.promsort <- df.prom2[order(-df.prom2$degree),]
cd <- centralization(netsym,degree)
cc <- centralization(netsym,closeness)
cb <- centralization(netsym,betweenness)
df.promsort <- rbind(df.promsort,data.frame(
name = "Centralization level",
degree = cd,
closeness = cc,
betweenness = cb
))
df.promsort## name degree closeness betweenness
## 8 T**a G***ghe 7.0000000 0.4166667 51.0000000
## 1 B***cu L***na 6.0000000 0.4761905 113.1666667
## 9 S**m An**la 6.0000000 0.4081633 36.0000000
## 19 D**a I***l 6.0000000 0.3846154 69.4000000
## 5 M**tu M**na 5.0000000 0.3278689 9.6666667
## 6 Ma**u I***he 5.0000000 0.3278689 9.6666667
## 12 M***u L**do 5.0000000 0.2564103 7.0000000
## 3 B**scu C***nel 4.0000000 0.3846154 4.1666667
## 7 T**a F**p 3.0000000 0.3174603 0.0000000
## 13 D**a D**a 3.0000000 0.3636364 16.6000000
## 14 D**a C**l 3.0000000 0.4444444 96.0000000
## 2 B***cu An***us 2.0000000 0.3333333 0.0000000
## 10 G**ca G****ghe 2.0000000 0.2531646 0.0000000
## 11 C**u I**n 2.0000000 0.2941176 3.6000000
## 15 N**cu P**u 2.0000000 0.2941176 2.8500000
## 16 N**se T**er 2.0000000 0.2941176 2.8500000
## 17 S***an C***tin 2.0000000 0.2941176 2.8500000
## 18 O***u A**ei 2.0000000 0.2941176 2.8500000
## 20 P**ci V***e 2.0000000 0.3076923 0.1666667
## 21 D***mir R**a 2.0000000 0.3076923 0.1666667
## 4 B**hiu G***ge 1.0000000 0.3278689 0.0000000
## 110 Centralization level 0.1973684 0.1518153 0.5127632
Alaturi de nodurile centrale, nodurile critice sunt o componenta de baza in structura unei retele. Prin nod critic se intelege un nod care daca este eliminat va afecta conectivitatea dintre alte perechi de noduri din retea. Prin codul urmator se arata cum pot fi determinate nodurile critice din cadrul retelei de traficanti.
# Cutpoints are nodes that if removed will affect the conectivity of the network
# In the graphic below, it is displayed with green the cutpoint nodes.
cpnet <- cutpoints(netsym,mode="graph",return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.cex=cpnet+2,vertex.col=cpnet+2,jitter=FALSE,
displaylabels=TRUE,label=netsym %v% "abrev_name")Similar cu nodurile critice, se poate defini si notiunea de muchie critica. Aceasta reprezinta o legatura care daca este eliminata, va afecta conectivitatea retelei. Codul urmator ilustreaza cum pot fi determinate aceste muchii critice in reteaua prezentata.
# Bridges are edges that if removed will affect the conectivity of the network
# In the graphic below it is displayed with green the edges that are bridges.
bridges <- function(dat,mode="graph",connected=c("strong", "weak")) {
e_cnt <- network.edgecount(dat)
if (mode == "graph") {
cmp_cnt <- components(dat)
b_vec <- rep(FALSE,e_cnt)
for(i in 1:e_cnt){
dat2 <- dat
delete.edges(dat2,i)
b_vec[i] <- (components(dat2) != cmp_cnt)
}
}
else {
cmp_cnt <- components(dat,connected=connected)
b_vec <- rep(FALSE,e_cnt)
for(i in 1:e_cnt){
dat2 <- dat
delete.edges(dat2,i)
b_vec[i] <- (components(dat2,connected=connected) != cmp_cnt)
}
}
return (b_vec)
}
bridges(netsym)## [1] FALSE FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13] TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
brnet <- bridges(netsym)
gplot(netsym,gmode="graph",vertex.col="red",edge.col=brnet+2,jitter=FALSE,
displaylabels=TRUE,label=netsym %v% "abrev_name",edge.lwd=3*brnet+2)Acest capitol este dedicat descoperirii subgrupurilor dintr-o retea. Acest tip de analiza are un rol foarte important, deoarece s-a observat ca in majoritatea retelelor sociale, indiferent de dimensiunea acestora, exista o tendinta de separare a actantilor in subgrupuri puternic interconectate, iar ale caror legaturi cu membrii din afara subgrupului sunt intr-un numar relativ mic. Desi pentru o retea de dimensiuni reduse nu este necesara o analiza amanuntita pentru a descoperi grupurile din cadrul unei retele, pentru dimensiuni considerabile ale retelelor, existenta subgrupurilor nu mai este atat de evidenta, iar complexitatea metodelor necesare trebuie sa fie mai mare.
Cea mai intuitiva abordare a subgrupurilor a fost de a le lega de notiunea de coeziune sociala, adica sunt considerate ca fiind subgrupuri submultimile de noduri ce contin cat mai multe conexiuni directe. In cazul retelelor care contin o componenta ce ofera informatii despre puterea unei legaturi (spre exemplu, intr-o retea de socializare putem privi relatiile de pretenie ca avand un grad determinat de frecventa de interactiune: zilnic, saptamanal, lunar, ocazional), aceasta poate fi integrata in determinarea subgrupurilor tinand cont de faptul ca legaturile mai slabe sunt folosite mai probabil pentru a conecta doua subgrupuri diferite decat pentru a conecta doua noduri din cadrul aceluiasi subgrup.
O prima abordare bazata pe notiunea de coeziune sociala, a fost de a considera subgrup doar submultimile care au conexiune intre oricare doua noduri. Mai exact, aceasta separare reprezinta de fapt, extragerea de subgrafuri complete din reteaua initiala. Un subgrup determinat prin aceasta metoda poarta denumirea de “clique”. Mai jos sunt utilizate cateva metode pentru determinarea acestora in reteaua de traficanti. Pentru a intelege mai bine rezultatele urmatoare sunt necesare doua observatii: * putem sa consideram o dimensiune minima pentru un subgrup, de regula 3 noduri, deoarece subgrupurile de dimensiune 1 si 2 nu sunt relevante (orice nod poate fi considerat un subgrup si orice doua noduri conectate pot fi considerate un subgrup). * subgrupurile formate din patru noduri cuprind (sub forma de subgraf) subgrupuri formate din trei noduri, deci are sens sa introducem notiunea de “clique” maximal (care nu mai poate fi extins prin adaugarea altor noduri).
## [1] 4
## [[1]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MI TF TG
##
## [[2]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] DD DC DI
##
## [[3]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] BL BA BC
##
## [[4]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] BL BC SA
##
## [[5]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] BL BC TG
##
## [[6]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MM MI TF
##
## [[7]]
## + 4/21 vertices, named, from cfd4cb3:
## [1] MM MI TF TG
##
## [[8]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MM MI GG
##
## [[9]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MM MI SA
##
## [[10]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MM MI TG
##
## [[11]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MM TF TG
## [[1]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] BA BL BC
##
## [[2]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] DC DD DI
##
## [[3]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] GG MM MI
##
## [[4]]
## + 4/21 vertices, named, from cfd4cb3:
## [1] TF MM TG MI
##
## [[5]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] MM MI SA
##
## [[6]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] BC BL TG
##
## [[7]]
## + 3/21 vertices, named, from cfd4cb3:
## [1] BC BL SA
## [[1]]
## + 4/21 vertices, named, from cfd4cb3:
## [1] TG MM MI TF
In majoritatea retelelor, constrangerea de a avea legaturi intre oricare doua noduri dintr-un subgrup este prea puternica, fapt ce conduce la determinarea unor subgrupuri de dimensiuni reduse, chiar si in cadrul retelelor foarte mari. Astfel, a fost introdusa notiunea de “k-Core”, care relaxeaxa cerinta legata de numarul de legaturi pe care trebuie sa le aiba un nod cu celelalte noduri din subgrup. Concret, daca extragem un k-Core, toate nodurile trebuie sa aiba gradul cel putin egal cu k. O observatie importanta este ca o analiza “1-Core” este echivalenta cu determinarea componentelor conexe din cadrul unui graf. In cele ce urmeaza sunt analizate componentele “k-Core” din cadrul retelei de traficanti.
## For each k, determine the number of nodes that are part of a k-Core (but not a (k+1)-Core, k is maximum)
coreness <- graph.coreness(inetsym)
table(coreness)## coreness
## 1 2 3
## 1 13 7
# Plot the network, with each node having its maximum k on it
maxCoreness <- max(coreness)
colors <- rainbow(maxCoreness)
plot(inetsym,vertex.label=coreness,vertex.color=colors[coreness],layout=layout_with_fr)# Gradually remove the nodes that are only part of 1-Cores and 2-Cores
i1_3 <- inetsym
i2_3 <- induced.subgraph(inetsym, vids=which(coreness > 1))
i3_3 <- induced.subgraph(inetsym, vids=which(coreness > 2))
lay <- layout.fruchterman.reingold(inetsym)
op <- par(mfrow=c(1,3),mar = c(3,0,2,0))
plot(i1_3,layout=lay,vertex.label=coreness,vertex.color=colors[coreness],main="All k-cores")
plot(i2_3,layout=lay[which(coreness > 1),],vertex.label=coreness[which(coreness > 1)],vertex.color=colors[coreness[which(coreness > 1)]],main="k-cores 2-3")
plot(i3_3,layout=lay[which(coreness > 2),],vertex.label=coreness[which(coreness > 2)],vertex.color=colors[coreness[which(coreness > 2)]],main="k-cores 3")Pentru a putea realiza o comparatie intre mai multe moduri de a imparti o retea in subgrupuri, este necesara existenta unei metode de a stabili cat de potrivita este o impartire in subgrupuri. Astfel, a fost introdusa notiunea de modularitate. Modularitate este o statistica ce poate fi calculata efectuand scaderea dintre probabilitatea ca alegand o legatura din retea aceasta sa fie intre noduri din acelasi subgrup si aceeasi probabilitate calculata intr-o retea formata din aceleasi noduri, dar in care muchiile sunt distribuite in mod aleator (numarul de muchii din reteaua initiala este conservat). Prin urmare, vom incerca sa realizam o impartire in subgrupuri a retelei de traficanti folosind drept criteriu rolul fiecarui actant. Se poate observa la sfarsit ca acest criteriu nu este cel mai potrivit tinand cont de faptul ca modularitatea obtinuta este negativa.
## Computing the modularity of the clusterization method
V(inetsym)$group <- strtoi(V(inetsym)$role)
modularity(inetsym, V(inetsym)$group)## [1] -0.1508488
## Visualizing the network by emphasizing the role of each node
colors <- brewer.pal(5,"Dark2")
V(inetsym)$color <- colors[strtoi(V(inetsym)$role)]
op <- par(mfrow=c(1,1))
plot(inetsym,vertex.color=V(inetsym)$color,vertex.size=20)Pana in acest moment, metodele prezentate (“clique” si “k-Core”) exploreaza doar legaturile interne din cadrul unui subgrup, nefiind analizate tipare ale legaturilor catre exteriorul unui subgrup. De aceea, au fost dezvoltati diversi algoritmi care sa exploreze aceasta zona. In cele ce urmeaza vom folosi mai multi algoritmi de acest tip, denumiti “Community Detection”, pentru a analiza rezultatele acestora pe reteaua de traficanti, precum si pentru a compara intre ele aceste rezultate (intre unii algoritmi se poate observa o similitudine in rezultate, data si de constructia similara a acestora).
## Applying multiple community detection algorithms
cw <- cluster_walktrap(inetsym)
modularity(cw); membership(cw)## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 3 3 3 3 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 2 2
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 2 2
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 2 2
## [1] 0.4695216
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 3 3 3 3 1 3 2 2 2 2 2 2 2 2 2 1 1
## [1] 0.4409722
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 1 1
## [1] 0.464892
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 3 3 3 3 1 3 2 2 2 2 2 2 2 2 2 3 3
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 3 3 3 3 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 1 1
##
## 1 2 3
## 1 2 0 0
## 2 6 3 3
## 3 0 0 1
## 4 1 3 0
## 5 0 2 0
## [1] 0.02816901
## [1] 1
## [1] 1
## [1] 0.7075812
# Visualizing the splitting made by each method
op <- par(mfrow=c(3,2),mar=c(3,0,2,0))
plot(ceb, inetsym,vertex.label=NA,main="Edge Betweenness")
plot(cfg, inetsym,vertex.label=NA,main="Fastgreedy")
plot(clp, inetsym,vertex.label=NA,main="Label Propagation")
plot(cle, inetsym,vertex.label=NA,main="Leading Eigenvector")
plot(cs, inetsym,vertex.label=NA,main="Spinglass")
plot(cw, inetsym,vertex.label=NA,main="Walktrap")Conceptele din acest capitol nu pot fi ilustrate pe reteaua traficantilor, de aceea exemple prezentate utilizeaza un set de date ilustrat in cartea din bibliografie. Aceste notiuni sunt aplicate pe grafuri in care legaturile dintre actanti nu sunt directe, ci sunt date de faptul ca cele doua persoane sunt parte al aceluiasi grup (de exemplu: clasa, departament, oras).
Un exemplu foarte uzual pentru acest tip de retele sunt cele denumite “2-Mode Networks” (nodurile din cadrul lor reprezinta doua clase diferite, fiind realizate legaturi doar intre obiecte de tipuri diferite). Mai jos este prezentata o retea formata din elevi si clase.
C1 <- c(1,1,1,0,0,0)
C2 <- c(0,1,1,1,0,0)
C3 <- c(0,0,1,1,1,0)
C4 <- c(0,0,0,0,1,1)
aff.df <- data.frame(C1,C2,C3,C4)
row.names(aff.df) <- c("S1","S2","S3","S4","S5","S6")
aff.df## C1 C2 C3 C4
## S1 1 0 0 0
## S2 1 1 0 0
## S3 1 1 1 0
## S4 0 1 1 0
## S5 0 0 1 1
## S6 0 0 0 1
Graful obtinut este bipartit, dupa cum se poate observa si din graficul urmator.
## Plotting the affiliation network to illustrate the bipartite property
bn <- graph.incidence(aff.df)
plt.x <- c(rep(2,6),rep(4,4))
plt.y <- c(7:2,6:3)
lay <- as.matrix(cbind(plt.x,plt.y))
shapes <- c("circle","square")
colors <- c("blue","red")
plot(bn,vertex.color=colors[V(bn)$type+1],vertex.shape=shapes[V(bn)$type+1],
vertex.size=10,vertex.label.degree=-pi/2,vertex.label.dist=1.2,
vertex.label.cex=0.9,layout=lay)Similar cu celelalte retele, si “affiliation networks” pot fi create atat pornind de la o matrice de incidenta, cat si de la o lista de muchii. In cele ce urmeaza sunt prezentate exemple pentru ambele metode.
## IGRAPH edef968 UN-B 10 11 --
## + attr: type (v/l), name (v/c)
## + edges from edef968 (vertex names):
## [1] S1--C1 S2--C1 S2--C2 S3--C1 S3--C2 S3--C3 S4--C2 S4--C3 S5--C3 S5--C4
## [11] S6--C4
## C1 C2 C3 C4
## S1 1 0 0 0
## S2 1 1 0 0
## S3 1 1 1 0
## S4 0 1 1 0
## S5 0 0 1 1
## S6 0 0 0 1
## [1] FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE
## [1] "S1" "S2" "S3" "S4" "S5" "S6" "C1" "C2" "C3" "C4"
## Creating Affiliation Networks from Edge Lists
el.df <- data.frame(rbind(c("S1","C1"),
c("S2","C1"),
c("S2","C2"),
c("S3","C1"),
c("S3","C2"),
c("S3","C3"),
c("S4","C2"),
c("S4","C3"),
c("S5","C3"),
c("S5","C4"),
c("S6","C4")))
bn2 <- graph.data.frame(el.df,directed=FALSE)
V(bn2)$type <- V(bn2)$name %in% el.df[,1]
bn2## IGRAPH 451c588 UN-B 10 11 --
## + attr: name (v/c), type (v/l)
## + edges from 451c588 (vertex names):
## [1] S1--C1 S2--C1 S2--C2 S3--C1 S3--C2 S3--C3 S4--C2 S4--C3 S5--C3 S5--C4
## [11] S6--C4
## [1] TRUE
O analiza interesanta ce poate fi realizata pe un “affiliation network”, este un studiu pe componente ce poate fi realizat cu ajutorul proiectiilor. O proiectie permite analiza doar unuia dintre cele doua tipuri de noduri prezente intr-o retea “2-Mode”. Legaturile dintre noduri in cadrul unei proiectii sunt date de legaturile indirecte din reteaua initiala (daca doi studenti stuadiaza in aceeasi clasa, atunci intre acestia va exista o legatura directa in proiectie). In cele ce urmeaza vom ilustra proiectiile pe reteaua de studenti si clase.
## Making the projections on both components
bn.pr <- bipartite.projection(bn)
bn.student <- bn.pr$proj1
bn.class <- bn.pr$proj2
get.adjacency(bn.student,sparse=FALSE,attr="weight")## S1 S2 S3 S4 S5 S6
## S1 0 1 1 0 0 0
## S2 1 0 2 1 0 0
## S3 1 2 0 2 1 0
## S4 0 1 2 0 1 0
## S5 0 0 1 1 0 1
## S6 0 0 0 0 1 0
## C1 C2 C3 C4
## C1 0 2 1 0
## C2 2 0 2 0
## C3 1 2 0 1
## C4 0 0 1 0
## Plotting the projections
shapes <- c("circle","square")
colors <- c("blue","red")
op <- par(mfrow=c(1,2))
plot(bn.student,vertex.color="blue",vertex.shape="circle",main="Students",
edge.width=E(bn.student)$weight*2,vertex.size=15,vertex.label.degree=-pi/2,
vertex.label.dist=1.2,vertex.label.cex=1)
plot(bn.class,vertex.color="red",vertex.shape="square",main="Classes",
edge.width=E(bn.student)$weight*2,vertex.size=15,vertex.label.degree=-pi/2,
vertex.label.dist=1.2,vertex.label.cex=1)In cele ce urmeaza, vom prezenta analiza unui set de date de tipul “2-Mode” ce cuprinde filme din perioada 1999-2014, precum si actorii care au avut cele mai importante roluri in aceste filme.
## IGRAPH 9cdab39 UN-B 1365 1600 --
## + attr: name (v/c), type (v/l), year (v/n), IMDBrating (v/n),
## | MPAArating (v/c)
## + edges from 9cdab39 (vertex names):
## [1] Inception --Leonardo DiCaprio
## [2] Inception --Joseph Gordon-Levitt
## [3] Inception --Ellen Page
## [4] Inception --Tom Hardy
## [5] Inception --Ken Watanabe
## [6] Inception --Dileep Rao
## [7] Inception --Cillian Murphy
## + ... omitted several edges
## [1] "Inception"
## [2] "Alice in Wonderland"
## [3] "Kick-Ass"
## [4] "Toy Story 3"
## [5] "How to Train Your Dragon"
## [6] "Despicable Me"
## [7] "Scott Pilgrim vs. the World"
## [8] "Hot Tub Time Machine"
## [9] "Harry Potter and the Deathly Hallows: Part 1"
## [10] "Tangled"
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [1] 8.8 6.5 7.8 8.4 8.2 7.7 7.5 6.5 7.7 7.9
## [1] "Notting Hill" "Eyes Wide Shut"
## [3] "The Green Mile" "10 Things I Hate About You"
## [5] "American Pie" "Girl, Interrupted"
## [7] "Leonardo DiCaprio" "Joseph Gordon-Levitt"
## [9] "Ellen Page" "Tom Hardy"
## [11] "Ken Watanabe"
## Plotting a part of the network
V(h1)$shape <- ifelse(V(h1)$type==TRUE,"square","circle")
V(h1)$shape[1:10]## [1] "square" "square" "square" "square" "square" "square" "square" "square"
## [9] "square" "square"
V(h1)$color <- ifelse(V(h1)$type==TRUE,"red","lightblue")
h2 <- subgraph.edges(h1, E(h1)[inc(V(h1)[name %in% c("The Wolf of Wall Street",
"Gangs of New York",
"The Departed")])])
plot(h2, layout = layout_with_kk)Mai departe este prezentata o analiza a actorilor, cu accent pe cei care au jucat in cele mai multe filme si cei care au jucat in cele mai apreciate filme.
## [1] 0.001718711
##
## 1 2 3 4 5 6 7 8
## 955 165 47 23 11 2 1 1
## [1] 1.327801
## [1] "Leonardo DiCaprio" "Emma Watson" "Richard Griffiths"
## [4] "Harry Melling" "Daniel Radcliffe" "Rupert Grint"
## [7] "James Franco" "Ian McKellen" "Martin Freeman"
## [10] "Bradley Cooper" "Christian Bale" "Samuel L. Jackson"
## [13] "Natalie Portman" "Brad Pitt" "Liam Neeson"
busy_actor <- data.frame(cbind(Actor = V(h1)[type==FALSE & deg > 4]$name,
Movies = V(h1)[type==FALSE & deg > 4]$deg))
busy_actor[order(busy_actor$Movies,decreasing=TRUE),]## Actor Movies
## 5 Daniel Radcliffe 8
## 11 Christian Bale 7
## 1 Leonardo DiCaprio 6
## 2 Emma Watson 6
## 3 Richard Griffiths 5
## 4 Harry Melling 5
## 6 Rupert Grint 5
## 7 James Franco 5
## 8 Ian McKellen 5
## 9 Martin Freeman 5
## 10 Bradley Cooper 5
## 12 Samuel L. Jackson 5
## 13 Natalie Portman 5
## 14 Brad Pitt 5
## 15 Liam Neeson 5
## Displaying actors from best movies
for (i in 161:1365) {
V(h1)[i]$totrating <- sum(V(h1)[nei(i)]$IMDBrating)
}
max(V(h1)$totrating,na.rm=TRUE)## [1] 60.9
pop_actor <- data.frame(
cbind(Actor = V(h1)[type==FALSE & totrating > 40]$name,
Popularity = V(h1)[type==FALSE & totrating > 40]$totrating))
pop_actor[order(pop_actor$Popularity,decreasing=TRUE),]## Actor Popularity
## 3 Daniel Radcliffe 60.9
## 4 Christian Bale 55.5
## 1 Leonardo DiCaprio 49.6
## 2 Emma Watson 45
## 5 Brad Pitt 40.5
In plus, putem analiza si relatii de dependenta intre datele pe care le extragem. De exemplu, se poate face o regresie intre numarul de filme in care a jucat un actor si media scorului acestor filme, pentru a determina daca exista sau nu o legatura liniara intre acestea. Dupa cum se poate vedea in urma analizei urmatoare, precum si din afisarea grafica a rezultatelor, nu se poate extrage o astfel de legatura.
for (i in 161:1365) {
V(h1)[i]$avgrating <- mean(V(h1)[nei(i)]$IMDBrating)
}
num <- V(h1)[type==FALSE]$deg
avgpop <- V(h1)[type==FALSE]$avgrating
summary(lm(avgpop ~ num))##
## Call:
## lm(formula = avgpop ~ num)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9858 -0.4330 0.1977 0.6170 1.6142
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.33868 0.05440 134.911 <2e-16 ***
## num 0.04714 0.03527 1.337 0.182
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9605 on 1203 degrees of freedom
## Multiple R-squared: 0.001483, Adjusted R-squared: 0.0006528
## F-statistic: 1.786 on 1 and 1203 DF, p-value: 0.1816
scatter.smooth(num,avgpop,col="lightblue",ylim=c(2,10),span=.8,
xlab="Number of Movies",ylab="Avg. Popularity")In ultima parte a analizei, ne vom uita la proiectiile acestei retele, in particular la cea a filmelor. In cazul acesta, vom analiza mai multe statistici, pentru ca in final sa vizualizam reteaua formata din filmele care au in comun actori cu macar cinci alte filme, din care se poate observa ca fac parte cu preponderenta serii de filme precum: Star Wars, Harry Potter, The Hobbit etc.
## Extract projections for the network
h1.pr <- bipartite.projection(h1)
h1.act <- h1.pr$proj1
h1.mov <- h1.pr$proj2
h1.act## IGRAPH ef907af UNW- 1205 6903 --
## + attr: name (v/c), year (v/n), IMDBrating (v/n), MPAArating (v/c),
## | shape (v/c), color (v/c), deg (v/n), totrating (v/n), avgrating
## | (v/n), weight (e/n)
## + edges from ef907af (vertex names):
## [1] Leonardo DiCaprio--Joseph Gordon-Levitt
## [2] Leonardo DiCaprio--Ellen Page
## [3] Leonardo DiCaprio--Tom Hardy
## [4] Leonardo DiCaprio--Ken Watanabe
## [5] Leonardo DiCaprio--Dileep Rao
## [6] Leonardo DiCaprio--Cillian Murphy
## + ... omitted several edges
## IGRAPH ebf349f UNW- 160 472 --
## + attr: name (v/c), year (v/n), IMDBrating (v/n), MPAArating (v/c),
## | shape (v/c), color (v/c), deg (v/n), totrating (v/n), avgrating
## | (v/n), weight (e/n)
## + edges from ebf349f (vertex names):
## [1] Inception--The Wolf of Wall Street Inception--Django Unchained
## [3] Inception--The Departed Inception--Gangs of New York
## [5] Inception--Catch Me If You Can Inception--The Dark Knight Rises
## [7] Inception--10 Things I Hate About You Inception--Batman Begins
## [9] Inception--The Dark Knight Inception--Training Day
## [11] Inception--Big Fish
## + ... omitted several edges
## Printing movie projection
op <- par(mar = rep(0, 4))
plot(h1.mov,vertex.color="red",vertex.shape="circle",
vertex.size=(V(h1.mov)$IMDBrating)-3,vertex.label=NA)## [1] 0.03710692
## [1] 12
## [1] 148 1 1 1 1 1 1 2 1 1 1 1
##
## 1 2 3 4 5 6 7 10
## 411 21 12 16 6 1 2 3
h2.mov <- induced.subgraph(h1.mov, vids=clusters(h1.mov)$membership==1)
plot(h2.mov,vertex.color="red",edge.width=sqrt(E(h1.mov)$weight),
vertex.shape="circle",vertex.size=(V(h2.mov)$IMDBrating)-3,vertex.label=NA)##
## 1 2 3 4 5 6 7
## 11 5 23 65 29 7 8
## Extracting and plotting only the nodes with coreness bigger than 4
h3.mov <- induced.subgraph(h2.mov,vids=graph.coreness(h2.mov)>4)
h3.mov## IGRAPH 5763188 UNW- 44 158 --
## + attr: name (v/c), year (v/n), IMDBrating (v/n), MPAArating (v/c),
## | shape (v/c), color (v/c), deg (v/n), totrating (v/n), avgrating
## | (v/n), weight (e/n)
## + edges from 5763188 (vertex names):
## [1] Alice in Wonderland --Hot Tub Time Machine
## [2] Hot Tub Time Machine --The Interview
## [3] The Hobbit: The Battle of the Five Armies--The Hobbit: The Desolation of Smaug
## [4] Inception --The Wolf of Wall Street
## [5] Exodus: Gods and Kings --American Hustle
## + ... omitted several edges
plot(h3.mov,vertex.color="red",vertex.shape="circle",
edge.width=sqrt(E(h1.mov)$weight),vertex.label.cex=0.7,
vertex.label.color="darkgreen",vertex.label.dist=0.3,
vertex.size=(V(h3.mov)$IMDBrating)-3)In analiza unei retele moderne sociale se desting urmatoarele caracterisici:
Este motivata de intelegerea intuitiva a structurii retelei bazata pe legaturile dintre actanti
Are la baza date empirice extrase intr-un mod sistematic
Se bazeaza foarte mult pe vizualizarea datelor utilizand metode grafice
Depinde de utilizarea modelelor matematice si computationale
Analizele prezentate pana in acest moment au pus accent pe primele trei concepte, iar in cele ce urmeaza il vom aborda pe cel din urma. Mai precis, vom incerca in continuare sa utilizam diferite modele pentru a genera o retea care sa aiba caracteristici similare cu reteaua initiala (cea a traficantilor).
O prima abordare luata in considerare, este propusa de Paul Erdos si Alfred Renyi. In aceasta metoda, reteaua este generata pornind de la un numar specificat de noduri si adaugand, in mod aleator, un numar specificat de muchii. Datorita acestei constructii, acest model este referit si sub denumirea de “random graph model”. Alternativ, pentru constructia unui astfel de model se poate specifica in locul numarului de muchii, o probabilitate de a avea muchie intre doua noduri ale retelei. In continuare, este prezentat codul pentru generarea retelei utilizand cele doua metode si vizualizarea grafica a rezultatelor comparativ cu reteaua initiala.
## Generate a similar network using Erdos-Renyi method (by specify the number of edges)
no_nodes <- length(V(inetsym))
no_edges <- length(E(inetsym))
er_net1 <- erdos.renyi.game(n=no_nodes,no_edges,type='gnm')
## Generate a similar network using Erdos-Renyi method (by specify the probability of having an edge between two nodes)
edge_prob <- no_edges / ((no_nodes-1)*no_nodes)
er_net2 <- erdos.renyi.game(n=no_nodes, edge_prob,type='gnp')
op <- par(mfrow=c(1,3))
plot(inetsym,vertex.label=NA,vertex.size=10)
plot(er_net1, vertex.label=NA, vertex.size=10)
plot(er_net2, vertex.label=NA, vertex.size=10)Modelul prezentat anterior este unul simplu de inteles, insa din cauza generalitatii sale, nu se pot genera retele care sa aiba anumite particularitati dorite (care sunt observate la o retea obtinuta empiric). Un astfel de exemplu, este faptul ca desi dimensiunile retelelor sociale pot fi de ordinul milioanelor de noduri, diametrul acestora este considerabil mai mic, fapt ce nu este foarte usor de replicat in modelul anterior. De aceea modelul “Small-World” doreste sa imbunatateasca acest lucru pornind de la o configuratie prestabilita a muchiilor retelei, urmata de o modificarea a acestora cu o anumita probabilitate. Se poate observa ca folosind probabilitatea de modificare a muchiilor cu valoare 1, configuratia initiala nu va mai conta, iar modelul va fi similar cu cel prezentat anterior. Inainte de a prezenta codul pentru generarea acestui model, vom explica cum arata configuratia initiala a retelei. Nodurile sunt asezate in cerc, iar fiecare nod este legat de k dintre cei mai apropiati vecini ai sai (atat cei din dreapta, cat si cei din stanga). In exemplu urmator vom determina acest k, tinand cont de gradul mediu al unui nod, iar pentru probabilitatea de modificarea a unei muchii vom utiliza trei valori diferite ale parametrului (0.25, 0.5, 0.75). Analizand grafic cat de similare sunt aceste retele comparativ cu cea initiala.
## Generating a similar network using Small-World Model
avg_degree <- 2*no_edges/no_nodes
ws_net1 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.25)
ws_net2 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.5)
ws_net3 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.75)
## Visualizing the results
op <- par(mfrow=c(2,2))
plot(inetsym,vertex.label=NA,vertex.size=10)
plot(ws_net1, vertex.label=NA, vertex.size=10)
plot(ws_net2, vertex.label=NA, vertex.size=10)
plot(ws_net3, vertex.label=NA, vertex.size=10)Din rezultatele grafice, se poate observa ca nici acest model nu este unul multumitor. In plus, o observatie importanta pentru cele doua modele este ca nici unul nu foloseste proprietati ale gradelor nodurilor din retea. Intr-o retea empirica, gradele nodurilor nu au o distributie apropiata de medie, existand multe noduri cu grad mic, dar si noduri cu grad considerabil mai mare decat medie (intr-o retea sociala, aceste noduri ar fi persoanele celebre din diferite domenii: actori, sportivi, politicieni etc.). Aceasta problema este adresata in modelul de generare “Scale-Free” utilizat mai jos.
## Generate a similar network using Scale-Free Model
b_net <- barabasi.game(no_nodes, directed=FALSE)
## Visualize the result
op <- par(mfrow=c(1,2))
plot(inetsym,vertex.label=NA, vertex.size=10)
plot(b_net,vertex.label=NA, vertex.size=10)In finalul acestui capitol, sunt prezentate statistici comparative ale retelelor generate si rezultatele observate in cadrul retelei empirice.
## Comparing random models with the empirical network
list_network <- c(er_net1, ws_net2, b_net, inetsym)
comparison_table <- data.frame(
Name = c("Erdos-Renyi", "Small world", "Scale-free model", "Empiric network"),
Size = c(length(V(er_net1)), length(V(ws_net2)), length(V(b_net)), length(V(inetsym))),
Density = c(gden(asNetwork(er_net1)),gden(asNetwork(ws_net2)),gden(asNetwork(b_net)),gden(asNetwork(inetsym))),
Avg_Degree = c(length(E(er_net1))/length(V(er_net1)),length(E(ws_net2))/length(V(ws_net2)),length(E(b_net))/length(V(b_net)),length(E(inetsym))/length(V(inetsym))),
Transitivity = c(transitivity(er_net1), transitivity(ws_net2), transitivity(b_net), transitivity(inetsym)),
Isolates = c(sum(degree(er_net1)==0),sum(degree(ws_net2)==0),sum(degree(b_net)==0),sum(degree(inetsym)==0))
)
comparison_table## Name Size Density Avg_Degree Transitivity Isolates
## 1 Erdos-Renyi 21 0.1714286 1.714286 0.16822430 0
## 2 Small world 21 0.1000000 1.000000 0.08571429 2
## 3 Scale-free model 21 0.0952381 0.952381 0.00000000 0
## 4 Empiric network 21 0.1714286 1.714286 0.25000000 0